;;************************************************************************
;; dashovrl.lsp 
;; contains code for datasheet overlay
;; copyright (c) 1998-2000 by Forrest W. Young
;;************************************************************************

;note that pop/put doesnt interact with system correctly
;to turn it on, change the default pop values here and 
;in isnew method below

(defmeth graph-proto :dash-buttons 
    (&key (margin (list 0 (+ 17 (send self :text-descent)) 0 0)) 
          (help t) (pop t) (lock t) (max t) (refresh t) (save t)
          (edit nil) (expand t) (labels t) (format t)
          )
  (when margin (apply #'send self :margin margin))
  (when (= *color-mode* 0) (setf color nil))
  (let ((overlay 
         (first (send self :add-overlay 
                      (send dash-overlay-proto :new :edit edit
                            :help help :lock lock :pop pop :save save
                            :max max :refresh refresh
                            :expand expand :labels labels :format format))))
        (graph self)
        )
    (defmeth self :do-motion (x y)
      (let* ((margin (send self :margin))
             )
        (cond
          ((and (> (second margin) 0) (<= y (second margin)))
           (send self :cursor 'solid-arrow))
          ((and (> (fourth margin) 0)
                (> y (- (send self :canvas-height) (fourth margin))))
           (send self :cursor 'solid-arrow))
          ((and (> (first margin) 0) (<= x (first margin)))
           (send self :cursor 'solid-arrow))
          ((and (> (third margin) 0) 
                (> x (- (send self :canvas-width) (third margin))))
           (send self :cursor 'solid-arrow))
          (t
           (when (not (eq (send self :cursor) (send self :set-mode-cursor)))
                 (send self :cursor) (send self :set-mode-cursor))
           (send self :do-brush-motion x y)))
        overlay))
    overlay))


(defproto dash-overlay-proto 
  '(lock max max-state refresh save expand labels format)  
   () vista-graph-overlay-proto)

(defmeth dash-overlay-proto :isnew 
  (&key (help t) (lock t) (pop t) (max t) (restore t) 
        (refresh t) (save nil) (edit nil)
        (expand t) (labels t) (format t))
  (call-next-method)
  (send self :edit edit)
  (send self :help help)
  (send self :pop  pop)
  (send self :lock lock)
  (send self :max max)
  (send self :refresh refresh)
  (send self :save save)
  (send self :expand expand)
  (send self :format format)
  (send self :labels labels)
  )


(defmeth dash-overlay-proto :buttons (&optional (list nil set))
"Args: (&optional logical)
Sets or returns which buttons are hilited."
  (if set (setf (slot-value 'buttons) list))
  (slot-value 'buttons))

(defmeth dash-overlay-proto :help (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns whether help button is to be drawn."
  (if set (setf (slot-value 'plot-help) logical))
  (slot-value 'plot-help))

(defmeth dash-overlay-proto :save (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns whether save button is to be drawn."
  (if set (setf (slot-value 'save) logical))
  (slot-value 'save))

(defmeth dash-overlay-proto :refresh (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns whether refresh button is to be drawn."
  (if set (setf (slot-value 'refresh) logical))
  (slot-value 'refresh))

(defmeth dash-overlay-proto :expand (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns whether refresh button is to be drawn."
  (if set (setf (slot-value 'expand) logical))
  (slot-value 'expand))

(defmeth dash-overlay-proto :format (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns whether refresh button is to be drawn."
  (if set (setf (slot-value 'format) logical))
  (slot-value 'format))

(defmeth dash-overlay-proto :labels (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns whether refresh button is to be drawn."
  (if set (setf (slot-value 'labels) logical))
  (slot-value 'labels))

(defmeth dash-overlay-proto :max-state (&optional (logical nil set))
"Args: (&optional logical)
Remembers maximize or restore state."
  (if set (setf (slot-value 'max-state) logical))
  (slot-value 'max-state))

(defmeth dash-overlay-proto :max (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns whether max button is to be drawn."
  (if set (setf (slot-value 'max) logical))
  (slot-value 'max))

(defmeth dash-overlay-proto :lock (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns whether lock button is to be drawn."
  (if set (setf (slot-value 'lock) logical))
  (slot-value 'lock))

(defmeth dash-overlay-proto :redraw ()
  (send self :redraw-the-overlay))

(defmeth dash-overlay-proto :redraw-the-overlay ()
  (let* ((graph (slot-value 'graph))
         (draw-color (send graph :draw-color))
         (color-mode *color-mode*)
         (vr (send graph :view-rect))
         (lefts (send self :lefts))
         (strings (send self :strings))
         (num-buts 
          (length 
           (remove 'nil 
                   (combine (send self :help) 
                            (send self :save) 
                            (send self :lock) 
                            (send self :pop) 
                            (send self :max)))))
         (i 0)
         (topy 3)
         (height 10)
         (width  10)
         (gap 2)
         (save-color 'black)
         (td (send graph :text-descent))
         (bottom-of-top (- (second (send graph :margin)) 3))
         (loc 0)
         (loc1 0)
         )
    (unless 
     (or (= 0 (third vr)) (= 0 (fourth vr)))
     (when (not color-mode) (send graph :use-color nil))
     (when (or (not (send self :old-canvas-width));fwy!
               (/= (send self :old-canvas-width) ;fwy!
                   (send graph :canvas-width)));fwy!
           (send self :old-canvas-width (send graph :canvas-width));fwy!
           (setf lefts nil) ;fwy!
           (send self :lefts nil));fwy!
     (when (not lefts) 
           (send self :setup-redraw)
           (setf lefts (send self :lefts))
           (setf strings (send self :strings))
           )
     (if (and color-mode (send *vista* :background-color))
         (send graph :draw-color 'toolbar-background)
         (send graph :draw-color 'white))
     (send graph :paint-rect (first vr) (second vr) (third vr) bottom-of-top)
     (send graph :draw-color draw-color)
     (send graph :draw-line (first vr) (+ (second vr) bottom-of-top)
           (+ (first vr) (third vr))
           (+ (second vr) bottom-of-top))
;---------
     (setf loc1 (if (> (length lefts) 3) (- num-buts 1) (1- (length lefts))))
     (setf loc (+ (select lefts loc1) 12 
                  (send graph :text-width 
                        (remove-trailing-blanks (select strings loc1)))))
     (send graph :draw-color 'light-blue)
     (send graph :paint-rect (+ (first vr) 2) (+ (second vr) 1) loc 15)
     (send graph :draw-color 'black)
     (send graph :frame-rect (+ (first vr) 2) (+ (second vr) 1) loc 15)
     ;---------
     (when (send self :help) (send self :draw-button nil i :vr vr) (setf i (1+ i)))
     (when (send self :save) 
           (when (send graph :edited)
                 (send graph :line-width 2)
                 (setf save-color 'red))
           (send self :draw-button nil i :vr vr 
                 :button-color save-color  :text-color save-color)
           (send graph :draw-color 'black)
           (send graph :line-width 1)
           (setf i (1+ i)))
     (when (send self :lock) 
           (send self :draw-button (not (send graph :editable)) i :vr vr) 
           (setf i (1+ i)))
     (when (send self :pop)  
           (send self :draw-button nil i :vr vr) 
           (setf i (1+ i)))
     (when (send self :max)  
           (send self :draw-button nil i :vr vr)
           (setf i (1+ i)))

     (when (send graph :editable)
           (setf loc (select (send self :lefts) i))
           (setf pallet-length (+ (- (first (last (send self :lefts))) 
                                     (- loc 2)) 10 5
                                  (send graph :text-width 
                                        (remove-trailing-blanks 
                                         (select strings (1- (length strings)))))))
           (send graph :draw-color 'light-blue)
           (send graph :paint-rect (- loc 3) (+ (second vr) 1) pallet-length 15)
           (send graph :draw-color 'black)
           (send graph :frame-rect (- loc 3) (+ (second vr) 1) pallet-length 15)
           ;-------------
           (when (send self :expand)  
                 (send self :draw-button nil i :vr vr) (setf i (1+ i)))
           (when (send self :format)  
                 (send self :draw-button nil i :vr vr) (setf i (1+ i)))
           (when (send self :labels)  
                 (send self :draw-button nil i :vr vr) (setf i (1+ i)))
           (setf loc (select (send self :lefts) (1- i))))
     (when (and (send self :lock) (send graph :editable)))
     )))

;(send (first (send *datasheet* :overlays)) :redraw-the-overlay)

(defmeth dash-overlay-proto :setup-redraw ()
  (let* ((graph (slot-value 'graph))
         (string (list "Help" "Save" "Lock"
                           (if (send self :pop-state) "Put" "Pop")))
         (string (combine string (if (send self :max-state) 
                                     "Restore    " 
                                     "Maximize    ")))
         (string (if (send self :lock)
                     (combine string (list "Expand" "Format" "Labels    "))
                     string))
         (short-string string)
         (buttons (list (send self :help)  (send self :save)
                        (send self :lock) (send self :pop) (send self :max)))
         (buttons (if (send self :lock)
                      (combine buttons (list (send self :expand) 
                             (send self :format)(send self :labels)))
                      buttons))
         (bar (send self :setup-redraw-button-bar string buttons short-string 0)) 
         (lefts (first bar))
         (strings (second bar))
         )
    (send self :num-top-buttons (length buttons))
    (send self :lefts lefts)
    (send self :strings strings)
    (send self :buttons (repeat nil (length buttons)))))

(defmeth dash-overlay-proto :switch-max-state ()
  (send self :max-state (not (send self :max-state)))
  (send (slot-value 'graph) :max-restore (send self :max-state))
  )

(defmeth dash-overlay-proto :switch-pop-state ()
  (send self :pop-state (not (send self :pop-state)))
  (send *workmap* :pop-out-toggle)
  )

(defmeth dash-overlay-proto :do-click (x y m1 m2)
  (send self :real-do-click x y m1 m2))

(defmeth dash-overlay-proto :real-do-click (x y m1 m2)
  (let* ((graph (slot-value 'graph))
         (dataobj (send graph :data-object))
         (lefts (send self :lefts))
         (height 10)
         (width  10)
         (gap 2)
         (topx 10)
         (topy 3)
         (bottom (+ topy height gap))
         (idling (select (copy-list (list (send graph :idle-on))) 0))
         (i 0)
         )
    (when (< y bottom)
          (when (send self :help)
                (when (and (< (select lefts i) x (+ width (select lefts i)))
                           (< topy y (+ topy height)))
                      (send graph :idle-on nil)
                      (send self :draw-button t i)
                      (send graph :plot-help)
                      (pause 10)
                      (send self :draw-button nil i)
                      (send graph :idle-on idling))
                (setf i (1+ i)))
          (when (send self :save)
                (when (and (< (select lefts i) x 
                              (+ width (select lefts i)))
                           (< topy y (+ topy height)))
                      (send graph :idle-on nil)
                      (send self :draw-button t i :button-color 'black :text-color 'red)
                      (pause 10)
                      (cond 
                        ((send dataobj :save-data nil nil nil graph) 
                         (send graph :edited nil)
                         (send (send graph :data-object) :edited nil)
                         (pause 10)
                         (send self :draw-button nil i)
                         (send self :redraw)
                         )
                        (t
                         (pause 10)
                         (send graph :line-width 2)
                         (send self :draw-button nil i :button-color 'red :text-color 'red)
                         (send graph :line-width 1)))
                      (send graph :idle-on idling))
                (setf i (1+ i)))
          (when (send self :lock)
                (when (and (< (select lefts i) x (+ width (select lefts i)))
                           (< topy y (+ topy height)))
                      (send graph :idle-on nil)
                      (send graph :switch-editable)
                      (send self :draw-button (not (send graph :editable)) i) 
                      (send graph :redraw)
                    ;;;
                      (send graph :idle-on idling))
                (setf i (1+ i)))
          (when (send self :pop)
                (when (and (< (select lefts i) x (+ width (select lefts i)))
                           (< topy y (+ topy height)))
                      (send graph :idle-on nil)
                      (send self :draw-button t i)
                      (pause 15)
                      (send self :switch-pop-state)
                      (send self :setup-redraw)
                      (send self :draw-button nil i)
                      (send self :redraw)
                      (send graph :idle-on idling))
                (setf i (1+ i)))

          (when (send self :max)
                (when (and (< (select lefts i) x (+ width (select lefts i)))
                           (< topy y (+ topy height)))
                      (send graph :idle-on nil)
                      (send self :draw-button t i)
                      (pause 15)
                      (send graph :start-buffering)
                      (send self :max-state (not (send self :max-state)))
                      (send self :setup-redraw)
                      (send self :draw-button nil i)
                      (send (slot-value 'graph) :max-restore (send self :max-state))
                      (send *max-datasheet-item* :enabled (not (send self :max-state)))
                      (send *restore-layout-item* :enabled (send self :max-state))
                      (send graph :buffer-to-screen)
                      (send graph :idle-on idling))
                (setf i (1+ i)))


          (when (and (send self :lock) (send graph :editable))
                (when (send self :expand)
                      (when (and (< (select lefts i) x 
                                    (+ width (select lefts i)))
                                 (< topy y (+ topy height)))
                            (send graph :idle-on nil)
                            (send self :draw-button t i); :bottom t
                            (send graph :expand-datasheet)
                            (pause 10)
                            (send self :draw-button nil i)); :bottom t
                      (send graph :idle-on idling)
                      (setf i (1+ i)))

                (when (send self :format)
                      (when (and (< (select lefts i) x 
                                    (+ width (select lefts i)))
                                 (< topy y (+ topy height)))
                            (send graph :idle-on nil)
                            (send self :draw-button t i); :bottom t
                            (send graph :format)
                            (pause 10)
                            (send self :draw-button nil i)); :bottom t
                      (send graph :idle-on idling)
                      (setf i (1+ i)))
                (when (send self :labels)
                      (when (and (< (select lefts i) x 
                                    (+ width (select lefts i)))
                                 (< topy y (+ topy height)))
                            (send graph :idle-on nil)
                            (send self :draw-button t i); :bottom t
                            (switch-label-variable)
                            (pause 10)
                            (send self :draw-button nil i)); :bottom t
                      (send graph :idle-on idling)
                      (setf i (1+ i))))

    
          )))
  


(defmeth datasheet-proto :format ()
  (let* ((old-ndecs (send self :number-of-decimals))
         (old-ncols (send self :number-of-columns))
         (mat (send (send self :data-object) :matrices))
         (col-text  (send text-item-proto :new 
                         (format nil "Width of Columns:")))
         (col-str  (send edit-text-item-proto :new 
                        (format nil "~a" old-ncols) :text-length 5))
         (dec-text (send text-item-proto :new 
                         (format nil "Number of Decimals")))
         (dec-str  (send edit-text-item-proto  :new (format nil "~a" old-ndecs)
                         :text-length 5))
         (ok (send modal-button-proto :new "OK"
                   :action (lambda ()
                             (list (send col-str :text) (send dec-str :text)))))
         (cancel (send modal-button-proto :new "Cancel"))
         (dialog (send modal-dialog-proto :new
                       (list (list col-str col-text)
                             (list dec-str dec-text)
                             (list ok cancel))))
         (result (send dialog :modal-dialog))
         (err)
         (tw        (send self :text-width "9"))
         (signw     (send self :text-width "-"))
         (dcimlw    (send self :text-width "."))
         )
    (send dialog :title "Reformat DataSheet")
    (when result
          (setf result 
                (mapcar #'(lambda (value)
                            (cond 
                              ((= (length value) 0)(setf err t))
                              (t
                               (setf value (read-from-string value))
                               (when (or (not (numberp value))(< value 0))(setf err t))
                               value)))
                        result))        
          (cond
            (err (vista-error-dialog "You must enter two numbers"))
            (t
             (setf new-ncols (first result))
             (when (< new-ncols  2) 
                   (vista-error-dialog "Minimum column width is 2")
                   (setf new-ncols 2))
             (setf new-ndecs (second result))
             (when (< new-ndecs  0) 
                   (vista-error-dialog "Number of decimals must be positive.")
                   (setf new-ndecs old-ndecs))
             (when (> new-ndecs  10) 
                   (vista-error-dialog "Number of decimals must be 10 or less.")
                   (setf new-ndecs 10))
             (send self :field-width (+ (* tw new-ncols) dcimlw signw 6))
             (send self :number-of-columns new-ncols)
             (send self :scroll 0 0)
             (send self :has-h-scroll 
                   (max (select (screen-size) 0)
                        (+ 1 (send self :label-width) (* (send self :field-width) 
                                                         (+ 1 (send self :nvar))))))
             (when (/= old-ndecs new-ndecs)
                   (send self :number-of-decimals new-ndecs)
                   (send self :create-data-matrix-strings))
             (send self :redraw)
             )))
    ))

(provide "dashovrl.lsp")